home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / prog / pbc23c.arj / ARCHIVES.BAS < prev    next >
BASIC Source File  |  1994-03-13  |  11KB  |  337 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |        PBClone  Copyright (c) 1990-1994  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   +----------------------------------------------------------------------+
  6.  
  7.    DECLARE FUNCTION AscM% (St$, BYVAL Posn%)
  8.    DECLARE FUNCTION Exist2% (FileName$)
  9.    DECLARE SUB FGetLoc (BYVAL FileHandle%, Posn&)
  10.    DECLARE SUB FindNextA (ErrCode%)
  11.    DECLARE SUB FOpen1 (FileName$, BYVAL ReadWrite%, BYVAL Sharing%, FileHandle%, ErrCode%)
  12.    DECLARE SUB FSetLoc (BYVAL FileHandle%, Posn&)
  13.    DECLARE SUB GetNameA (FileName$, FileNameLen%)
  14.    DECLARE SUB MatchFile (PatternName$, FileName$, IsMatch%)
  15.    DECLARE SUB ParseFSpec (FileSpec$, Drive$, DLen%, Subdir$, SLen%, File$, FLen%)
  16.    DECLARE SUB SFRead (BYVAL FileHandle%, St$, BytesRead%, ErrCode%)
  17.  
  18.    DECLARE SUB GetArc00 (Handle%, ArcType%, File$, Header$)
  19.    DECLARE SUB SetArc00 (BYVAL Handle%, BYVAL ArcType%, File$, Header$)
  20.  
  21.  
  22.  
  23. SUB FindFirstA (Archive$, FileName$, ErrCode%)
  24.    ErrCode% = 0
  25.    File$ = LEFT$(FileName$, 12)
  26.    Arc$ = UCASE$(Archive$)
  27.  
  28.    IF INSTR(Arc$, ".") = 0 THEN
  29.       IF Exist2%(Arc$ + ".ZIP") THEN
  30.          Arc$ = Arc$ + ".ZIP"
  31.       ELSEIF Exist2%(Arc$ + ".LZH") THEN
  32.          Arc$ = Arc$ + ".LZH"
  33.       ELSEIF Exist2%(Arc$ + ".ARC") THEN
  34.          Arc$ = Arc$ + ".ARC"
  35.       ELSEIF Exist2%(Arc$ + ".PAK") THEN
  36.          Arc$ = Arc$ + ".PAK"
  37.       ELSEIF Exist2%(Arc$ + ".ZOO") THEN
  38.          Arc$ = Arc$ + ".ZOO"
  39.       ELSEIF Exist2%(Arc$ + ".ARJ") THEN
  40.          Arc$ = Arc$ + ".ARJ"
  41.       ELSEIF Exist2%(Arc$ + ".EXE") THEN
  42.          Arc$ = Arc$ + ".EXE"
  43.       ELSEIF Exist2%(Arc$ + ".COM") THEN
  44.          Arc$ = Arc$ + ".COM"
  45.       ELSE
  46.          Arc$ = Arc$ + "."
  47.       END IF
  48.    END IF
  49.  
  50.    SELECT CASE RIGHT$(Arc$, 3)
  51.       CASE "ARC", "PAK"
  52.          ArcType% = 1
  53.       CASE "LZH"
  54.          ArcType% = 2
  55.       CASE "ZIP"
  56.          ArcType% = 3
  57.       CASE "ZOO"
  58.          ArcType% = 4
  59.       CASE "ARJ"
  60.          ArcType% = 5
  61.       CASE "COM", "EXE"
  62.          ArcType% = -1
  63.       CASE ELSE
  64.          ErrCode% = 9999
  65.    END SELECT
  66.  
  67.    Posn& = 1&
  68.  
  69.    IF ErrCode% = 0 THEN FOpen1 Arc$, 0, 2, Handle%, ErrCode%
  70.    IF ErrCode% = 0 AND ArcType% = -1 THEN
  71.       Header$ = "xx"
  72.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  73.       IF ErrCode% = 0 THEN IF Header$ <> "MZ" THEN ErrCode% = 9999
  74.       IF ErrCode% = 0 THEN                       ' check for LHARC .EXE
  75.          FSetLoc Handle%, 1637&
  76.          Header$ = SPACE$(8)
  77.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  78.          IF ErrCode% = 0 THEN
  79.             IF MID$(Header$, 3, 3) = "-lh" THEN
  80.                ArcType% = 2
  81.                FSetLoc Handle%, 1637&
  82.                Posn& = 1637&
  83.             END IF
  84.          END IF
  85.       END IF
  86.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for old PKZIP .EXE
  87.          FSetLoc Handle%, 12785&
  88.          Header$ = SPACE$(4)
  89.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  90.          IF ErrCode% = 0 THEN
  91.             IF LEFT$(Header$, 4) = "PK" + CHR$(3) + CHR$(4) THEN
  92.                ArcType% = 3
  93.                Posn& = 12785&
  94.                FSetLoc Handle%, Posn&
  95.             END IF
  96.          END IF
  97.       END IF
  98.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for new PKZIP .EXE
  99.          FSetLoc Handle%, 15771&
  100.          Header$ = SPACE$(4)
  101.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  102.          IF ErrCode% = 0 THEN
  103.             IF LEFT$(Header$, 4) = "PK" + CHR$(3) + CHR$(4) THEN
  104.                ArcType% = 3
  105.                Posn& = 15771&
  106.                FSetLoc Handle%, Posn&
  107.             END IF
  108.          END IF
  109.       END IF
  110.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' check for ARJ .EXE
  111.          FSetLoc Handle%, 14859&
  112.          Header$ = SPACE$(2)
  113.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  114.          IF ErrCode% = 0 THEN
  115.             IF Header$ = CHR$(&H60) + CHR$(&HEA) THEN
  116.                ArcType% = 5
  117.                FSetLoc Handle%, 14859&
  118.                Posn& = 14859&
  119.             END IF
  120.          END IF
  121.       END IF
  122.       IF ErrCode% = 0 AND ArcType% = -1 THEN     ' ...not an EXE format we know
  123.          ErrCode% = 9999
  124.       END IF
  125.    END IF
  126.    IF ErrCode% = 0 THEN
  127.       Header$ = SPACE$(128)
  128.       SFRead Handle%, Header$, BytesRead%, ErrCode%
  129.       SetArc00 Handle%, ArcType%, File$, Header$
  130.       SELECT CASE ArcType%
  131.          CASE 1
  132.             IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  133.          CASE 2
  134.             IF MID$(Header$, 3, 1) <> "-" THEN ErrCode% = 9999
  135.          CASE 3
  136.             IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  137.          CASE 4
  138.             IF MID$(Header$, 21, 4) = CHR$(&HDC) + CHR$(&HA7) + CHR$(&HC4) + CHR$(&HFD) THEN
  139.                Posn& = CVL(MID$(Header$, &H19, 4)) + 1&
  140.                FSetLoc Handle%, Posn&
  141.                SFRead Handle%, Header$, BytesRead%, ErrCode%
  142.             ELSE
  143.                ErrCode% = 9999
  144.             END IF
  145.          CASE 5
  146.             IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) THEN
  147.                ErrCode% = 9999
  148.             ELSE
  149.                Posn& = CLNG(CVI(MID$(Header$, 3, 2))) + 11&
  150.                FSetLoc Handle%, Posn&
  151.                SFRead Handle%, Header$, BytesRead%, ErrCode%
  152.             END IF
  153.       END SELECT
  154.       IF ErrCode% < 0 THEN
  155.          IF BytesRead% THEN
  156.             ErrCode% = 0
  157.             Header$ = LEFT$(Header$, BytesRead%)
  158.          END IF
  159.       END IF
  160.       IF ErrCode% = 0 THEN
  161.          SetArc00 Handle%, ArcType%, File$, Header$
  162.          FSetLoc Handle%, Posn&
  163.          CurFile$ = SPACE$(80)
  164.          GetNameA CurFile$, FLen%
  165.          IF FLen% THEN
  166.             FileSpec$ = LEFT$(CurFile$, FLen%)
  167.             Drive$ = " "
  168.             SubDir$ = SPACE$(64)
  169.             CurFile$ = SPACE$(12)
  170.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  171.             Drive$ = LEFT$(Drive$, DLen%)
  172.             SubDir$ = LEFT$(SubDir$, SLen%)
  173.             CurFile$ = LEFT$(CurFile$, FLen%)
  174.             MatchFile File$, CurFile$, Found%
  175.          ELSE
  176.             Found% = 0
  177.          END IF
  178.       END IF
  179.       IF ErrCode% OR NOT Found% THEN
  180.          FindNextA ErrCode%
  181.       END IF
  182.    END IF
  183. END SUB
  184.  
  185.  
  186.  
  187. SUB FindNextA (ErrCode%)
  188.    File$ = SPACE$(12)
  189.    Header$ = SPACE$(128)
  190.    GetArc00 Handle%, ArcType%, File$, Header$
  191.    IF Handle% THEN
  192.       File$ = RTRIM$(File$)
  193.    ELSE
  194.       ErrCode% = -1
  195.    END IF
  196.    DO UNTIL ErrCode% OR Found%
  197.       FGetLoc Handle%, Posn&
  198.       SELECT CASE ArcType%
  199.          CASE 1
  200.             IF AscM%(Header$, 2) = 1 THEN
  201.                Posn& = Posn& + 25&
  202.             ELSE
  203.                Posn& = Posn& + 29&
  204.             END IF
  205.             Posn& = Posn& + CVL(MID$(Header$, 16, 4))
  206.          CASE 2
  207.             Posn& = Posn& + (ASC(Header$) + 2) + CVL(MID$(Header$, 8, 4))
  208.          CASE 3
  209.             Posn& = Posn& + 30& + CVI(MID$(Header$, 27, 2))
  210.             Posn& = Posn& + CVI(MID$(Header$, 29, 2))
  211.             Posn& = Posn& + CVL(MID$(Header$, 19, 4))
  212.          CASE 4
  213.             Posn& = CVL(MID$(Header$, 7, 4)) + 1&
  214.          CASE 5
  215.             Posn& = Posn& + CLNG(CVI(MID$(Header$, 3, 2))) + CVL(MID$(Header$, 17, 4)) + 10&
  216.       END SELECT
  217.       IF ErrCode% = 0 THEN
  218.          FSetLoc Handle%, Posn&
  219.          Header$ = SPACE$(128)
  220.          SFRead Handle%, Header$, BytesRead%, ErrCode%
  221.       END IF
  222.       IF ErrCode% < 0 THEN
  223.          IF BytesRead% THEN
  224.             ErrCode% = 0
  225.             Header$ = LEFT$(Header$, BytesRead%)
  226.          END IF
  227.       END IF
  228.       SELECT CASE ArcType%
  229.          CASE 1: IF LEFT$(Header$, 1) <> CHR$(26) OR MID$(Header$, 2, 1) = CHR$(0) THEN ErrCode% = 9999
  230.          CASE 2: IF MID$(Header$, 3, 1) <> "-" OR LEFT$(Header$, 1) = CHR$(0) THEN ErrCode% = 9999
  231.          CASE 3: IF LEFT$(Header$, 4) <> "PK" + CHR$(3) + CHR$(4) THEN ErrCode% = 9999
  232.          CASE 5: IF LEFT$(Header$, 2) <> CHR$(&H60) + CHR$(&HEA) OR CVI(MID$(Header$, 3, 2)) = 0 THEN ErrCode% = 9999
  233.       END SELECT
  234.       IF ErrCode% = 0 THEN
  235.          SetArc00 Handle%, ArcType%, File$, Header$
  236.          FSetLoc Handle%, Posn&
  237.          CurFile$ = SPACE$(12)
  238.          GetNameA CurFile$, FLen%
  239.          IF FLen% THEN
  240.             FileSpec$ = LEFT$(CurFile$, FLen%)
  241.             Drive$ = " "
  242.             SubDir$ = SPACE$(64)
  243.             CurFile$ = SPACE$(12)
  244.             ParseFSpec FileSpec$, Drive$, DLen%, SubDir$, SLen%, CurFile$, FLen%
  245.             Drive$ = LEFT$(Drive$, DLen%)
  246.             SubDir$ = LEFT$(SubDir$, SLen%)
  247.             CurFile$ = LEFT$(CurFile$, FLen%)
  248.             MatchFile File$, CurFile$, Found%
  249.          ELSE
  250.             Found% = 0
  251.          END IF
  252.       END IF
  253.    LOOP
  254. END SUB
  255.  
  256.  
  257.  
  258. SUB GetNameA (FileName$, FLen%)
  259.    File$ = SPACE$(12)
  260.    Header$ = SPACE$(128)
  261.    GetArc00 Handle%, ArcType%, File$, Header$
  262.    SELECT CASE ArcType%
  263.       CASE 1
  264.          St$ = MID$(Header$, 3, 13)
  265.          FLen% = INSTR(St$, CHR$(0))
  266.          IF FLen% THEN
  267.             FLen% = FLen% - 1
  268.          ELSE
  269.             FLen% = 12
  270.          END IF
  271.          MID$(FileName$, 1, FLen%) = St$
  272.       CASE 2
  273.          FLen% = AscM%(Header$, 22)
  274.          MID$(FileName$, 1) = MID$(Header$, 23, FLen%)
  275.       CASE 3
  276.          FLen% = AscM%(Header$, 27)
  277.          MID$(FileName$, 1) = MID$(Header$, 31, FLen%)
  278.       CASE 4
  279.          IF AscM%(Header$, 31) = 1 THEN
  280.             FLen% = 0
  281.          ELSE
  282.             FLen% = INSTR(MID$(Header$, 39, 13), CHR$(0)) - 1
  283.             MID$(FileName$, 1) = MID$(Header$, 39, FLen%)
  284.          END IF
  285.       CASE 5
  286.          IF AscM%(Header$, 11) > 1 THEN
  287.             FLen% = 0
  288.          ELSE
  289.             St$ = MID$(Header$, 35, 80)
  290.             FLen% = INSTR(St$, CHR$(0))
  291.             IF FLen% THEN FLen% = FLen% - 1
  292.             MID$(FileName$, 1, FLen%) = St$
  293.          END IF
  294.    END SELECT
  295. END SUB
  296.  
  297.  
  298.  
  299. SUB GetStoreA (Storage$)
  300.    File$ = SPACE$(12)
  301.    Storage$ = File$
  302.    Header$ = SPACE$(128)
  303.    GetArc00 Handle%, ArcType%, File$, Header$
  304.    SELECT CASE ArcType%
  305.       CASE 1
  306.          SELECT CASE AscM%(Header$, 2)
  307.             CASE 1, 2: Storage$ = "Stored  "
  308.             CASE 3: Storage$ = "Packed  "
  309.             CASE 4: Storage$ = "Squeezed"
  310.             CASE 5, 6: Storage$ = "crunched"
  311.             CASE 7, 8: Storage$ = "Crunched"
  312.             CASE 9: Storage$ = "Squashed"
  313.             CASE 10: Storage$ = "Crushed "
  314.             CASE 11: Storage$ = "Distill "
  315.             CASE ELSE
  316.          END SELECT
  317.       CASE 2
  318.          Storage$ = LEFT$(MID$(Header$, 3, 5) + SPACE$(8), 8)
  319.       CASE 3
  320.          SELECT CASE AscM%(Header$, 9)
  321.             CASE 0: Storage$ = "Stored  "
  322.             CASE 1: Storage$ = "Shrunk  "
  323.             CASE 2: Storage$ = "Reduce-1"
  324.             CASE 3: Storage$ = "Reduce-2"
  325.             CASE 4: Storage$ = "Reduce-3"
  326.             CASE 5: Storage$ = "Reduce-4"
  327.             CASE 6: Storage$ = "Imploded"
  328.             CASE 8: Storage$ = "Deflated"
  329.             CASE ELSE: Storage$ = SPACE$(8)
  330.          END SELECT
  331.       CASE 4
  332.          Storage$ = SPACE$(8)
  333.       CASE 5
  334.          Storage$ = CHR$(AscM%(Header$, 10) + 48) + SPACE$(7)
  335.    END SELECT
  336. END SUB
  337.